home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / top / o_syntax.t < prev    next >
Encoding:
Text File  |  1989-12-05  |  3.1 KB  |  63 lines
  1. (herald orbit_syntax)
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; Syntax changes from T2 to T3.
  27.  
  28. (define-syntax (lap vars . instructions)
  29.   `(,primop/lap ,(create-primop-node instructions) ,@vars))
  30.  
  31. (define-syntax (lap-template  . instructions)
  32.   `(,primop/lap-template ,(create-primop-node instructions)))
  33.  
  34. (define-syntax (define-foreign name name-params value)
  35.   (let* ((vars (do ((i (length name-params) (- i 1))
  36.                    (vars '() (cons (generate-symbol 'foreign) vars)))
  37.                   ((= i 1) vars)))
  38.      (f-name (if (symbol? (car name-params))
  39.              (string->symbol
  40.               (string-downcase! (symbol->string (car name-params))))
  41.              (string->symbol (car name-params))))
  42.         (fo (create-literal-node (object nil 
  43.                                    ((foreign-name self) f-name))))
  44.         (reps (create-primop-node (reverse (cdr name-params))))
  45.         (value-rep (create-primop-node value)))
  46.     `(define ,name
  47.        (lambda ,vars
  48.          (call-foreign ,fo ,reps ,value-rep ,@vars)))))
  49.  
  50. (set (syntax-table-entry (env-syntax-table t-implementation-env) 'lap)
  51.      (syntax-table-entry (env-syntax-table orbit-env) 'lap))
  52.  
  53. (set (syntax-table-entry (env-syntax-table t-implementation-env) 'lap-template)
  54.      (syntax-table-entry (env-syntax-table orbit-env) 'lap-template))
  55.  
  56. (set (syntax-table-entry (env-syntax-table t-implementation-env) 'define-foreign)
  57.      (syntax-table-entry (env-syntax-table orbit-env) 'define-foreign))
  58.                                                                           
  59. (set (syntax-table-entry standard-syntax-table 'define-foreign)
  60.      (syntax-table-entry (env-syntax-table orbit-env) 'define-foreign))
  61.                                                                           
  62.                            
  63.